home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / xlib / yicons24 / source / play_cmf.c < prev    next >
Text File  |  1992-04-05  |  8KB  |  266 lines

  1. eat
  2.     Color := RandColor;
  3.     SetColor(Color);
  4.     SetFillStyle(Random(CloseDotFill)+1, Color);
  5.     Bar3D(Random(MaxWidth), Random(MaxHeight),
  6.           Random(MaxWidth), Random(MaxHeight), 0, TopOff);
  7.   until KeyPressed;
  8.   WaitToGo;
  9. end; { RandBarPlay }
  10.  
  11. procedure ArcPlay;
  12. { Draw random arcs on the screen }
  13. var
  14.   MaxRadius : word;
  15.   EndAngle : word;
  16.   ArcInfo : ArcCoordsType;
  17. begin
  18.   MainWindow('Arc / GetArcCoords demonstration');
  19.   StatusLine('Esc aborts or press a key');
  20.   MaxRadius := MaxY div 10;
  21.   repeat
  22.     SetColor(RandColor);
  23.     EndAngle := Random(360);
  24.     SetLineStyle(SolidLn, 0, NormWidth);
  25.     Arc(Random(MaxX), Random(MaxY), Random(EndAngle), EndAngle, Random(MaxRadius));
  26.     GetArcCoords(ArcInfo);
  27.     with ArcInfo do
  28.     begin
  29.       Line(X, Y, XStart, YStart);
  30.       Line(X, Y, Xend, Yend);
  31.     end;
  32.   until KeyPressed;
  33.   WaitToGo;
  34. end; { ArcPlay }
  35.  
  36. procedure PutPixelPlay;
  37. { Demonstrate the PutPixel and GetPixel commands }
  38. const
  39.   Seed   = 1962; { A seed for the random number generator }
  40.   NumPts = 2000; { The number of pixels plotted }
  41.   Esc    = #27;
  42. var
  43.   I : word;
  44.   X, Y, Color : word;
  45.   XMax, YMax  : integer;
  46.   ViewInfo    : ViewPortType;
  47. begin
  48.   MainWindow('PutPixel / GetPixel demonstration');
  49.   StatusLine('Esc aborts or press a key...');
  50.  
  51.   GetViewSettings(ViewInfo);
  52.   with ViewInfo do
  53.   begin
  54.     XMax := (x2-x1-1);
  55.     YMax := (y2-y1-1);
  56.   end;
  57.  
  58.   while not KeyPressed do
  59.   begin
  60.     { Plot random pixels }
  61.     RandSeed := Seed;
  62.     I := 0;
  63.     while (not KeyPressed) and (I < NumPts) do
  64.     begin
  65.       Inc(I);
  66.         PutPixel(Random(XMax)+1, Random(YMax)+1, RandColor);
  67.     end;
  68.  
  69.     { Erase pixels }
  70.     RandSeed := Seed;
  71.     I := 0;
  72.     while (not KeyPressed) and (I < NumPts) do
  73.     begin
  74.       Inc(I);
  75.       X := Random(XMax)+1;
  76.       Y := Random(YMax)+1;
  77.       Color := GetPixel(X, Y);
  78.         if Color = RandColor then
  79.           PutPixel(X, Y, 0);
  80.      end;
  81.   end;
  82.   WaitToGo;
  83. end; { PutPixelPlay }
  84.  
  85. procedure PutImagePlay;
  86. { Demonstrate the GetImage and PutImage commands }
  87.  
  88. const
  89.   r  = 20;
  90.   StartX = 100;
  91.   StartY = 50;
  92.  
  93. var
  94.   CurPort : ViewPortType;
  95.  
  96. procedure MoveSaucer(var X, Y : integer; Width, Height : integer);
  97. var
  98.   Step : integer;
  99. begin
  100.   Step := Random(2*r);
  101.   if Odd(Step) then
  102.     Step := -Step;
  103.   X := X + Step;
  104.   Step := Random(r);
  105.   if Odd(Step) then
  106.     Step := -Step;
  107.   Y := Y + Step;
  108.  
  109.   { Make saucer bounce off viewport walls }
  110.   with CurPort do
  111.   begin
  112.     if (x1 + X + Width - 1 > x2) then
  113.       X := x2-x1 - Width + 1
  114.     else
  115.       if (X < 0) then
  116.         X := 0;
  117.     if (y1 + Y + Height - 1 > y2) then
  118.       Y := y2-y1 - Height + 1
  119.     else
  120.       if (Y < 0) then
  121.         Y := 0;
  122.   end;
  123. end; { MoveSaucer }
  124.  
  125. var
  126.   Pausetime : word;
  127.   Saucer    : pointer;
  128.   X, Y      : integer;
  129.   ulx, uly  : word;
  130.   lrx, lry  : word;
  131.   Size      : word;
  132.   I         : word;
  133. begin
  134.   ClearDevice;
  135.   FullPort;
  136.  
  137.   { PaintScreen }
  138.   ClearDevice;
  139.   MainWindow('GetImage / PutImage Demonstration');
  140.   StatusLine('Esc aborts or press a key...');
  141.   GetViewSettings(CurPort);
  142.  
  143.   { DrawSaucer }
  144.   Ellipse(StartX, StartY, 0, 360, r, (r div 3)+2);
  145.   Ellipse(StartX, StartY-4, 190, 357, r, r div 3);
  146.   Line(StartX+7, StartY-6, StartX+10, StartY-12);
  147.   Circle(StartX+10, StartY-12, 2);
  148.   Line(StartX-7, StartY-6, StartX-10, StartY-12);
  149.   Circle(StartX-10, StartY-12, 2);
  150.   SetFillStyle(SolidFill, MaxColor);
  151.   FloodFill(StartX+1, StartY+4, GetColor);
  152.  
  153.   { ReadSaucerImage }
  154.   ulx := StartX-(r+1);
  155.   uly := StartY-14;
  156.   lrx := StartX+(r+1);
  157.   lry := StartY+(r div 3)+3;
  158.  
  159.   Size := ImageSize(ulx, uly, lrx, lry);
  160.   GetMem(Saucer, Size);
  161.   GetImage(ulx, uly, lrx, lry, Saucer^);
  162. {  PutImage(ulx, uly, Saucer^, XORput);               { erase image }
  163.  
  164.   { Plot some "stars" }
  165.   for I := 1 to 1000 do
  166.      PutPixel(Random(MaxX), Random(MaxY), RandColor);
  167.   X := MaxX div 2;
  168.   Y := MaxY div 2;
  169.   PauseTime := 70;
  170.  
  171.   { Move the saucer around }
  172.   repeat
  173. {     PutImage(X, Y, Saucer^, XORput);                 { draw image }
  174.      Delay(PauseTime);
  175. {     PutImage(X, Y, Saucer^, XORput);                 { erase image }
  176.      MoveSaucer(X, Y, lrx - ulx + 1, lry - uly + 1);  { width/height }
  177.   until KeyPressed;
  178.   FreeMem(Saucer, size);
  179.   WaitToGo;
  180. end; { PutImagePlay }
  181.  
  182. procedure PolyPlay;
  183. { Draw random polygons with random fill styles on the screen }
  184. const
  185.   MaxPts = 5;
  186. type
  187.   PolygonType = array[1..MaxPts] of PointType;
  188. var
  189.   Poly : PolygonType;
  190.   I, Color : word;
  191. begin
  192.   MainWindow('FillPoly demonstration');
  193.   StatusLine('Esc aborts or press a key...');
  194.   repeat
  195.     Color := RandColor;
  196.     SetFillStyle(Random(11)+1, Color);
  197.     SetColor(Color);
  198.     for I := 1 to MaxPts do
  199.       with Poly[I] do
  200.       begin
  201.         X := Random(MaxX);
  202.         Y := Random(MaxY);
  203.       end;
  204.     FillPoly(MaxPts, Poly);
  205.   until KeyPressed;
  206.   WaitToGo;
  207. end; { PolyPlay }
  208.  
  209. procedure FillStylePlay;
  210. { Display all of the predefined fill styles available }
  211. var
  212.   Style    : word;
  213.   Width    : word;
  214.   Height   : word;
  215.   X, Y     : word;
  216.   I, J     : word;
  217.   ViewInfo : ViewPortType;
  218.  
  219. procedure DrawBox(X, Y : word);
  220. begin
  221.   SetFillStyle(Style, MaxColor);
  222.   with ViewInfo do
  223.     Bar(X, Y, X+Width, Y+Height);
  224.   Rectangle(X, Y, X+Width, Y+Height);
  225.   OutTextXY(X+(Width div 2), Y+Height+4, Int2Str(Style));
  226.   Inc(Style);
  227. end; { DrawBox }
  228.  
  229. begin
  230.   MainWindow('Pre-defined fill styles');
  231.   GetViewSettings(ViewInfo);
  232.   with ViewInfo do
  233.   begin
  234.     Width := 2 * ((x2+1) div 13);
  235.     Height := 2 * ((y2-10) div 10);
  236.   end;
  237.   X := Width div 2;
  238.   Y := Height div 2;
  239.   Style := 0;
  240.   for J := 1 to 3 do
  241.   begin
  242.     for I := 1 to 4 do
  243.     begin
  244.       DrawBox(X, Y);
  245.       Inc(X, (Width div 2) * 3);
  246.     end;
  247.     X := Width div 2;
  248.     Inc(Y, (Height div 2) * 3);
  249.   end;
  250.   SetTextJustify(LeftText, TopText);
  251.   WaitToGo;
  252. end; { FillStylePlay }
  253.  
  254. procedure FillPatternPlay;
  255. { Display some user defined fill patterns }
  256. const
  257.   Patterns : array[0..11] of FillPatternType = (
  258.   ($AA, $55, $AA, $55, $AA, $55, $AA, $55 üÖü üÖü  !BBäx!!!BBäx!BBäx"""DDêp""DDêp>"""BBääêp""!"BDäêêp>IÉÆ|      ° @≥î>00>><Dêx  !BBäx""DDêp&<"DDêê&22TTêêê$> $< @äêp>          ⁿBBBB<  @@Ç****DDDDDDDU¬U¬U¬U¬U¬U¬U¬▌w▌w▌w▌w▌w▌w▌w°°°≥■°°≥≥■≥≥■■°°°    ≤  ≤  ≤≤         °                     ≡≡≡≡≡≡≡≡≡≡≡≡≡≡       ;DDD;    $"Bdÿ>@@@>||>Ac]AAA1N"A""2,  `1NA"*III*<Bü üB<<BüüüB<A" \"QIE" < <BBBB  @@    ~ ?  @ÇB$$B ""A$$"AII6 üBr»$**IIII**ccregion.  The region is defined as any pixel of
  259.             OldColor which has a path of pixels of OldColor or NewColor
  260.             with sides touching back to the seed point, (XSeed, YSeed).
  261.             Therefore, only pixels of OldColor are modified and no other
  262.             information is changed.
  263.  
  264.             SEE ALSO
  265.  
  266.             DRWFILLBOX, DRWFILLCIRCLE, DR